000100* COBOLUNIT
000200* FILE : CBUDUMP[.CBL]
000300
000400* THIS PROGRAM CAN BE USED TO PRINT THE CONTENT OF THE
000500* CBU-ctx DATA STRUCTURE WHICH CONTAINES THE DETAILED
000600* DESCRIPTION OF "SUITES", "TESTS" AND "ASSERTS"
000700* (FOR DEBUGGING PURPOSE)
000800
000900 IDENTIFICATION DIVISION.
001000 PROGRAM-ID. CBUDUMP.
001100 ENVIRONMENT DIVISION.
001200 CONFIGURATION SECTION.
001300 DATA DIVISION.
001400 WORKING-STORAGE SECTION.
001500 01  i PIC S9(4) COMP.
001600 01  j PIC S9(4) COMP.
001700 01  k PIC S9(4) COMP.
001800     COPY CBUC0004.
001900
002000
002100 01 CBU-TEXT-AND-VALUE-LINE.
002200    05 CBU-TEXT-PART          PIC X(32).
002300    05 CBU-VALUE-PART         PIC X(83).
002400    05 CBU-PRINT-INTEGER      REDEFINES CBU-VALUE-PART
002500                              PIC S9(9).
002600    05 CBU-PRINT-DECIMAL      REDEFINES CBU-VALUE-PART
002700                                  PIC +9(9)V,9(3).
002800
002900 LINKAGE SECTION.
003000     COPY CBUC0000.
003100
003200 PROCEDURE DIVISION USING CBU-ctx.
003300
003400 MAIN.
003500
003600     MOVE "EN201" TO CBU-MESSAGE-TO-PRINT
003700     SET CBU-PRINT-AS-A-TITLE TO TRUE
003800     PERFORM CALLPRINT
003900
004000     MOVE "TestError              :" TO CBU-TEXT-PART
004100     MOVE TestError                 TO CBU-PRINT-INTEGER
004200     PERFORM CALLPRINT0
004300
004400     MOVE "RunFailureCount        :" TO CBU-TEXT-PART
004500     MOVE RunFailureCount           TO CBU-PRINT-INTEGER
004600     PERFORM CALLPRINT0
004700
004800     MOVE "RunSuccessCount        :" TO CBU-TEXT-PART
004900     MOVE RunSuccessCount           TO CBU-PRINT-INTEGER
005000     PERFORM CALLPRINT0
005100
005200     MOVE "TestRunCount           :" TO CBU-TEXT-PART
005300     MOVE TestRunCount              TO CBU-PRINT-INTEGER
005400     PERFORM CALLPRINT0
005500
005600     MOVE "AssertFailureCount     :" TO CBU-TEXT-PART
005700     MOVE AssertFailureCount        TO CBU-PRINT-INTEGER
005800     PERFORM CALLPRINT0
005900
006000     MOVE "AssertTestCount        :" TO CBU-TEXT-PART
006100     MOVE AssertTestCount           TO CBU-PRINT-INTEGER
006200     PERFORM CALLPRINT0
006300
006400
006500     MOVE "nb-suite-run           :" TO CBU-TEXT-PART
006600     MOVE nb-suite-run              TO CBU-PRINT-INTEGER
006700     PERFORM CALLPRINT0
006800
006900     MOVE "index-current-suite    :" TO CBU-TEXT-PART
007000     MOVE index-current-suite       TO CBU-PRINT-INTEGER
007100     PERFORM CALLPRINT0
007200
007300     MOVE "index-current-test     :" TO CBU-TEXT-PART
007400     MOVE index-current-test        TO CBU-PRINT-INTEGER
007500     PERFORM CALLPRINT0
007600
007700     MOVE "name-current-suite     :" TO CBU-TEXT-PART
007800     MOVE name-current-suite        TO CBU-VALUE-PART
007900     PERFORM CALLPRINT0
008000
008100     MOVE "name-current-test      :" TO CBU-TEXT-PART
008200     MOVE name-current-test         TO CBU-VALUE-PART
008300     PERFORM CALLPRINT0
008400
008500     MOVE "SuiteIndex             :" TO CBU-TEXT-PART
008600     MOVE SuiteIndex                TO CBU-PRINT-INTEGER
008700     PERFORM CALLPRINT0
008800
008900     MOVE "TestIndex              :" TO CBU-TEXT-PART
009000     MOVE TestIndex                 TO CBU-PRINT-INTEGER
009100     PERFORM CALLPRINT0
009200
009300     MOVE "INFORMATION ON 'SUITES'" TO CBU-TEXT-PART
009400     SET CBU-PRINT-AS-A-TITLE       TO TRUE
009500     PERFORM CALLPRINT0
009600
009700
009800     PERFORM VARYING I FROM 1 BY 1 UNTIL I > SUITEINDEX
009900
010000     MOVE 3 TO CBU-PRINT-SPACING-NUM
010100     MOVE "SUITE NUMERO :" TO CBU-TEXT-PART
010200     MOVE I                         TO CBU-PRINT-INTEGER
010300     PERFORM CALLPRINT0
010400
010500     MOVE "--------------:" TO CBU-TEXT-PART
010600     PERFORM CALLPRINT0
010700
010800     MOVE 2 TO CBU-PRINT-SPACING-NUM
010900     MOVE " SuiteName             :" TO CBU-TEXT-PART
011000     MOVE SuiteName (i)             TO CBU-VALUE-PART
011100     PERFORM CALLPRINT0
011200
011300     MOVE " SuiteDesc (troncated) :" TO CBU-TEXT-PART
011400     MOVE SuiteDesc (i)             TO CBU-VALUE-PART
011500     PERFORM CALLPRINT0
011600
011700     MOVE " nb-test-size          :" TO CBU-TEXT-PART
011800     MOVE nb-test-size (i)          TO CBU-PRINT-INTEGER
011900     PERFORM CALLPRINT0
012000
012100     MOVE " nb-test-run           :" TO CBU-TEXT-PART
012200     MOVE nb-test-run (i)           TO CBU-PRINT-INTEGER
012300     PERFORM CALLPRINT0
012400
012500     MOVE " nb-test-failed        :" TO CBU-TEXT-PART
012600     MOVE nb-test-failed (i)        TO CBU-PRINT-INTEGER
012700     PERFORM CALLPRINT0
012800
012900     MOVE " nb-test-error         :" TO CBU-TEXT-PART
013000     MOVE nb-test-error (i)         TO CBU-PRINT-INTEGER
013100     PERFORM CALLPRINT0
013200
013300     MOVE 2 TO CBU-PRINT-SPACING-NUM
013400     MOVE " INFORMATIONS RELATIVES AUX TESTS DE CETTE SUITE "
013500                                    TO CBU-TEXT-PART
013600     PERFORM CALLPRINT0
013700
013800     perform varying j from 1 by 1 until j > testIndex
013900
014000     if suite-reference (j) = i
014100        perform
014200           MOVE 2 TO CBU-PRINT-SPACING-NUM
014300           MOVE " TEST NUMERO "           TO CBU-TEXT-PART
014400           MOVE j                         TO CBU-PRINT-INTEGER
014500           PERFORM CALLPRINT0
014600
014700           MOVE "--------------"          TO CBU-TEXT-PART
014800           PERFORM CALLPRINT0
014900
015000           MOVE 2 TO CBU-PRINT-SPACING-NUM
015100           MOVE " TestName              :" TO CBU-TEXT-PART
015200           MOVE TestName (j)              TO CBU-VALUE-PART
015300           PERFORM CALLPRINT0
015400
015500           MOVE " TestProgName          :" TO CBU-TEXT-PART
015600           MOVE TestProgName (j)          TO CBU-VALUE-PART
015700           PERFORM CALLPRINT0
015800
015900           MOVE " TestDesc              :" TO CBU-TEXT-PART
016000           MOVE TestDesc (j)              TO CBU-VALUE-PART
016100           PERFORM CALLPRINT0
016200
016300           MOVE " nb-assert-run         :" TO CBU-TEXT-PART
016400           MOVE nb-assert-run (j)         TO CBU-PRINT-INTEGER
016500           PERFORM CALLPRINT0
016600
016700           MOVE " nb-assert-succeed     :" TO CBU-TEXT-PART
016800           MOVE nb-assert-succeed (j)     TO CBU-PRINT-INTEGER
016900           PERFORM CALLPRINT0
017000
017100           MOVE " nb-assert-failed      :" TO CBU-TEXT-PART
017200           MOVE nb-assert-failed (j)      TO CBU-PRINT-INTEGER
017300           PERFORM CALLPRINT0
017400
017500       end-perform
017510     END-IF
017600     END-PERFORM
017700     END-PERFORM.
017800     GOBACK.
017900
018000 CALLPRINT0.
018100     STRING "..000" CBU-TEXT-PART "%" CBU-VALUE-PART
018200     DELIMITED BY SIZE INTO CBU-MESSAGE-TO-PRINT.
018300     PERFORM CALLPRINT.
018400     MOVE SPACE TO CBU-TEXT-PART
018500     MOVE SPACE TO CBU-VALUE-PART.
018600
018700 CALLPRINT.
018800
018900* PRINT CURRENT LINE
019000     MOVE CBU-LANGUAGE TO CBU-MSG-LG
019100     CALL CBU-log-print USING CBU-LOG-PRINT-INTERFACE
019200* RESET DEFAULTS
019300     SET CBU-PRINT-A-LINE TO TRUE
019400     SET CBU-PRINT-ON-NEXT-LINE TO TRUE
019500     INITIALIZE CBU-MESSAGE-TO-PRINT.
019600
